' Display a message box telling the user how to undo this change
MsgBox "Custom toolbar set. Run the RestoreBuiltInUI macro to clear the custom toolbar.", _
vbInformation, DVS_TITLE
' Exit the procedure bypassing the error handler
Exit Sub
errHandler:
' Display a message to let the user know that we detected that
' Visio was not running
MsgBox "Visio must be running!", vbOKOnly, DVS_TITLE
End Sub
Sub ChangeToolbarButtonIcon()
'Developing Visio Solutions, Chapter 16, "Customizing Visio's User Interface"
'This example demonstrates:
' retrieving an instance of Visio
' retrieving a copy of Visio's built-in toolbars (MSOffice flavor)
' retrieving a specific toolbarset (Drawing)
' retrieving a specific toolbaritem (TurnToNextPage)
' modifying the icon on a toolbaritem (DVS icon)
' setting the custom toolbar for use by Visio
Dim appVisio As Visio.Application ' Visio instance
Dim uiObj As Visio.UIObject
Dim toolbarSetObj As Visio.ToolbarSet
Dim toolbarItemsObj As Visio.ToolbarItems
Dim toolbarItemObj As Visio.ToolbarItem
Dim i As Integer ' Loop variable
Dim bFound As Boolean ' Found flag
' Set an error handler
On Error GoTo errHandler
' Retrieve the current instance of Visio
Set appVisio = GetObject(, "visio.application")
' Get the UI object for the copy of the MSOffice toolbars
Set uiObj = appVisio.BuiltInToolbars(visToolBarMSOffice)
' Get the Drawing Window toolbarsets
' NOTE: You must use ItemAtID to get the toolbarset
' using uiObj.ToolbarSets(visUIObjSetDrawing) will not work
Set toolbarSetObj = uiObj.ToolbarSets.ItemAtID(visUIObjSetDrawing)
' Get the ToolbarItems collection
Set toolbarItemsObj = toolbarSetObj.Toolbars(4).ToolbarItems
' Get the ToolbarItem for the NextPage toolbarbutton
bFound = False
For i = 0 To toolbarItemsObj.Count - 1
Set toolbarItemObj = toolbarItemsObj(i)
If toolbarItemObj.CmdNum = Visio.visCmdTurnToNextPage Then
bFound = True
Exit For
End If
Next i
If bFound Then
' set the icon to our DVS icon
toolbarItemObj.IconFileName "dvs.ico"
' Tell Visio to actually use the new custom UI
appVisio.ActiveDocument.SetCustomToolbars uiObj
' Display a message box telling the user how to undo this change
MsgBox "Custom toolbar set. Run the RestoreBuiltInUI macro to clear the custom toolbar.", _
vbInformation, DVS_TITLE
Else
' Let the user know we couldn't find the toolbarbutton
' This shouldn't happen since were starting from the builtin toolbars
MsgBox "Unable to locate toolbar button", vbOKOnly, DVS_TITLE
End If
' Exit the procedure bypassing the error handler
Exit Sub
errHandler:
' Display a message to let the user know that we detected that
' Visio was not running
MsgBox "Visio must be running!", vbOKOnly, DVS_TITLE
End Sub
Sub ChangeToolbarButtonPriority()
Attribute ChangeToolbarButtonPriority.VB_Description = "Changes the priority of the TurnToNextPage button so that it will have a lower probability of being removed fom the toolbar."
'Developing Visio Solutions, Chapter 16, "Customizing Visio's User Interface"
'This example demonstrates:
' retrieving an instance of Visio
' retrieving a copy of Visio's built-in toolbars
' retrieving a specific toolbarset
' retrieving a specific toolbaritem (TurnToNextPage)
' modifying the priority of a toolbaritem
' setting the custom toolbar for use by Visio
Dim appVisio As Visio.Application ' Visio instance
Dim uiObj As Visio.UIObject
Dim toolbarSetObj As Visio.ToolbarSet
Dim toolbarItemsObj As Visio.ToolbarItems
Dim toolbarItemObj As Visio.ToolbarItem
Dim i As Integer ' Loop variable
Dim bFound As Boolean ' Found flag
' Set an error handler
On Error GoTo errHandler
' Retrieve the current instance of Visio
Set appVisio = GetObject(, "visio.application")
' Get the UI object for the copy of the MSOffice toolbars
Set uiObj = appVisio.BuiltInToolbars(visToolBarMSOffice)
' Get the Drawing Window toolbarsets
' NOTE: You must use ItemAtID to get the toolbarset
' using uiObj.ToolbarSets(visUIObjSetDrawing) will not work
Set toolbarSetObj = uiObj.ToolbarSets.ItemAtID(visUIObjSetDrawing)
' Get the ToolbarItems collection
Set toolbarItemsObj = toolbarSetObj.Toolbars(4).ToolbarItems
' Get the ToolbarItem for the NextPage toolbarbutton
' While we know that it will be found since we retrieved the builtin toolbars,
' this example demonstrates a technique that can be used when a custom toolbar
' is being searched.
bFound = False
For i = 0 To toolbarItemsObj.Count - 1
Set toolbarItemObj = toolbarItemsObj(i)
If toolbarItemObj.CmdNum = Visio.visCmdTurnToNextPage Then
bFound = True
Exit For
End If
Next i
If bFound Then
' set the priority to 1 (highest)
toolbarItemObj.Priority = 1
' Tell Visio to actually use the new custom UI
appVisio.ActiveDocument.SetCustomToolbars uiObj
' Display a message box telling the user how to undo this change
MsgBox "Custom toolbar set. Run the RestoreBuiltInUI macro to clear the custom toolbar.", _
vbInformation, DVS_TITLE
Else
' Let the user know we couldn't find the toolbarbutton
' This shouldn't happen since were starting from the builtin toolbars
MsgBox "Unable to locate toolbar button", vbOKOnly, DVS_TITLE
End If
' Exit the procedure bypassing the error handler
Exit Sub
errHandler:
' Display a message to let the user know that we detected that
' Visio was not running
MsgBox "Visio must be running!", vbOKOnly, DVS_TITLE
End Sub
Sub DeleteAccelItem()
'Developing Visio Solutions, Chapter 16, "Customizing Visio's User Interface"
'This example demonstrates:
' retrieving an instance of Visio
' retrieving a copy of Visio's built-in menus
' retrieving a specific menuset (Drawing)
' retrieving a specific menu (Format)
' deleting the menu
' setting the custom menu for use by Visio
Dim appVisio As Visio.Application ' Visio instance
Dim uiObj As Visio.UIObject
Dim accelTableObj As Visio.AccelTable
Dim accelItemsObj As Visio.AccelItems
Dim accelItemObj As Visio.AccelItem
Dim i As Integer
' Set an error handler
On Error GoTo errHandler
' Retrieve the current instance of Visio
Set appVisio = GetObject(, "visio.application")
' Retrieve the UIObject for the copy of the BuiltInMenus
Set uiObj = appVisio.BuiltInMenus
' Set accelTableObj to the Drawing menu set
Set accelTableObj = uiObj.AccelTables.ItemAtID(visUIObjSetDrawing)
' retrieve the accelerator items collections
Set accelItemsObj = accelTableObj.AccelItems
' retrieve the accelerator item for the Visual Basic Editor
' To do this we must iterate through the collection and locate the item
' of interest. The item can be identified either by checking the CmdNum for
' the number we're interested in or by checking for the specific key. Since
' checking for the key requires looking at the Alt, Control, Shift, and Key
' properties it is better to use the CmdNum.
' Since we retrieved the builtin menus, we know that we can find the accelerator.
' If we had started from a custom menu, we would need to handle the case of
' not finding the accelerator.
For i = 0 To accelItemsObj.Count - 1
Set accelItemObj = accelItemsObj.Item(i)
If accelItemObj.CmdNum = Visio.visCmdToolsRunVBE Then
Exit For
End If
Next i
' delete the accelerator
accelItemObj.Delete
' Tell Visio to use the new UI
appVisio.ActiveDocument.SetCustomMenus uiObj
' Display a message box telling the user how to undo this change
MsgBox "Custom menu set. Run the RestoreBuiltInUI macro to clear the custom menu.", _
vbInformation, DVS_TITLE
' Exit the procedure bypassing the error handler
Exit Sub
errHandler:
' Display a message to let the user know that we detected that
' Visio was not running
MsgBox "Visio must be running!", vbOKOnly, DVS_TITLE
End Sub
Sub DeleteHierarchicalMenuItem()
'Developing Visio Solutions, Chapter 16, "Customizing Visio's User Interface"
'This example demonstrates:
' retrieving an instance of Visio
' retrieving a copy of Visio's built-in menus
' retrieving a specific menuset (Drawing)
' retrieving a specific menu (Tools)
' retrieving a specific menuitem from the menu (Macro)
' retrieving the menuitems collection for the hierarchical menu
' retrieving a specific menuitem from the menuitems collection (Run VBE)
' deleting the menuitem
' setting the custom menu for use by Visio
Dim appVisio As Visio.Application ' Visio instance
Dim uiObj As Visio.UIObject ' BuiltInMenus UIObject
Dim menuSetObj As Visio.MenuSet ' Drawing menuset
Dim menuObj As Visio.Menu ' Window menu
Dim menuItemsObj As Visio.MenuItems ' Window menu MenuItems collection
Dim menuItemObj As Visio.MenuItem ' MenuItem (ultimately Macro)
Dim hiermenuItemsObj As Visio.MenuItems ' Macro hierarchical MenuItems collection
Dim hiermenuItemObj As Visio.MenuItem ' Macro hierarchical MenuItem (Run VBE)
Dim i, j As Integer ' Loop variables
' Set an error handler
On Error GoTo errHandler
' Retrieve the current instance of Visio
Set appVisio = GetObject(, "visio.application")
' Retrieve the UIObject for the copy of the BuiltInMenus
Set uiObj = appVisio.BuiltInMenus
' Set menuSetObj to the Drawing menu set
Set menuSetObj = uiObj.MenuSets.ItemAtID(visUIObjSetDrawing)
' retrieve the Tools menu
' Since we retrieved the builtin menus, we know that we can find the Tools menu
' by its position. If we had retrieved a custom UI, we would have to loop through
' the menus checking the caption to find the Tools menu. In a custom menu there
' is no guarantee that we would find a Tools menu since it could be deleted.
Set menuObj = menuSetObj.Menus(5)
' retrieve the MenuItems collection for the Tools menu
Set menuItemsObj = menuObj.MenuItems
' locate the Macro menuitem
' Since we retrieved the builtin menus we know we will find it. If we had
' started from a custom menu we would need to handle the case of not finding
' the menuitem.
For i = 0 To menuItemsObj.Count - 1
' retrieve the current menuitem from the collection
Set menuItemObj = menuItemsObj(i)
' check the CmdNum to see if it is the Macro... command
If menuItemObj.CmdNum = Visio.visCmdHierarchical And _
menuItemObj.Caption = "&Macro" Then
' retrieve the menuitems collection for the hierarchical menu
Set hiermenuItemsObj = menuItemObj.MenuItems
' locate the Visual Basic Editor menuitem
' As with the Macro menuitem, we know we will find the VBE menuitem
' since we started with a copy of the builtin menus.
For j = 0 To hiermenuItemsObj.Count - 1
' retrieve menuitem from collection
Set hiermenuItemObj = hiermenuItemsObj(j)
' check the CmdNum to see if it is Run VBE
If hiermenuItemObj.CmdNum = Visio.visCmdToolsRunVBE Then
' delete the Visual Basic Editor menuitem
' Note: since the list of macros/add-ons is built keying off of this item
' the menuitems for all the add-ons and macros that are normally seen
' under the Visual Basic Editor menuitem will also disappear
hiermenuItemObj.Delete
' Exit the inside for loop
Exit For
End If
Next j
' Exit the outer for loop
Exit For
End If
Next i
' Tell Visio to use the new UI
appVisio.ActiveDocument.SetCustomMenus uiObj
' Display a message box telling the user how to undo this change
MsgBox "Custom menu set. Run the RestoreBuiltInUI macro to clear the custom menu.", _
vbInformation, DVS_TITLE
' Exit the procedure bypassing the error handler
Exit Sub
errHandler:
' Display a message to let the user know that we detected that
' Visio was not running
MsgBox "Visio must be running!", vbOKOnly, DVS_TITLE
End Sub
Sub DeleteMenu()
Attribute DeleteMenu.VB_Description = "Deletes the Format menu from the Drawing menuset."
'Developing Visio Solutions, Chapter 16, "Customizing Visio's User Interface"
'This example demonstrates:
' retrieving an instance of Visio
' retrieving a copy of Visio's built-in menus
' retrieving a specific menuset (Drawing)
' retrieving a specific menu (Format)
' deleting the menu
' setting the custom menu for use by Visio
Dim appVisio As Visio.Application ' Visio instance
Dim uiObj As Visio.UIObject
Dim menuSetObj As Visio.MenuSet
Dim menuObj As Visio.Menu
' Set an error handler
On Error GoTo errHandler
' Retrieve the current instance of Visio
Set appVisio = GetObject(, "visio.application")
' Retrieve the UIObject for the copy of the BuiltInMenus
Set uiObj = appVisio.BuiltInMenus
' Set menuSetObj to the Drawing menu set
Set menuSetObj = uiObj.MenuSets.ItemAtID(visUIObjSetDrawing)
' retrieve the Format menu
' Since we retrieved the builtin menus, we know that we can find the format menu
' by its position. If we had retrieved a custom UI, we would have to loop through
' the menus checking the caption to find the Format menu. In a custom menu there
' is no guarantee that we would find a Format menu since it could be deleted.
Set menuObj = menuSetObj.Menus(4)
' delete the Format menu
menuObj.Delete
' Tell Visio to use the new UI
appVisio.ActiveDocument.SetCustomMenus uiObj
' Display a message box telling the user how to undo this change
MsgBox "Custom menu set. Run the RestoreBuiltInUI macro to clear the custom menu.", _
vbInformation, DVS_TITLE
' Exit the procedure bypassing the error handler
Exit Sub
errHandler:
' Display a message to let the user know that we detected that
' Visio was not running
MsgBox "Visio must be running!", vbOKOnly, DVS_TITLE
End Sub
Sub DeleteMenuItem()
Attribute DeleteMenuItem.VB_Description = "Deletes the ShowShapeSheet menuitem from the Drawing Window menu."
'Developing Visio Solutions, Chapter 16, "Customizing Visio's User Interface"
'This example demonstrates:
' retrieving an instance of Visio
' retrieving a copy of Visio's built-in menus
' retrieving a specific menuset (Drawing)
' retrieving a specific menu (Window)
' retrieving a specific menuitem from the menu (Show ShapeSheet)
' deleting the menuitem
' setting the custom menu for use by Visio
Dim appVisio As Visio.Application ' Visio instance
Dim uiObj As Visio.UIObject ' BuiltInMenus UIObject
Dim menuSetObj As Visio.MenuSet ' Drawing menuset
Dim menuObj As Visio.Menu ' Window menu
Dim menuItemsObj As Visio.MenuItems ' Window menu MenuItems collection
Dim menuItemObj As Visio.MenuItem ' MenuItem (ultimately Show ShapeSheet)
Dim i As Integer ' Loop variable
' Set an error handler
On Error GoTo errHandler
' Retrieve the current instance of Visio
Set appVisio = GetObject(, "visio.application")
' Retrieve the UIObject for the copy of the BuiltInMenus
Set uiObj = appVisio.BuiltInMenus
' Set menuSetObj to the Drawing menu set
Set menuSetObj = uiObj.MenuSets.ItemAtID(visUIObjSetDrawing)
' retrieve the Window menu
' Since we retrieved the builtin menus, we know that we can find the window menu
' by its position. If we had retrieved a custom UI, we would have to loop through
' the menus checking the caption to find the Window menu. In a custom menu there
' is no guarantee that we would find a Window menu since it could be deleted.
Set menuObj = menuSetObj.Menus(7)
' retrieve the MenuItems collection for the Window menu
Set menuItemsObj = menuObj.MenuItems
' locate the Show ShapeSheet menuitem
' Since we retrieved the builtin menus we know we will find it. If we had
' started from a custom menu we would need to handle the case of not finding
' the menuitem.
For i = 0 To menuItemsObj.Count - 1
' retrieve the current menuitem from the collection
Set menuItemObj = menuItemsObj(i)
' check the CmdNum to see if it is Show ShapeSheet
If menuItemObj.CmdNum = Visio.visCmdWindowShowShapeSheet Then
' delete the Show ShapeSheet menuitem
menuItemObj.Delete
Exit For
End If
Next i
' Tell Visio to use the new UI
appVisio.ActiveDocument.SetCustomMenus uiObj
' Display a message box telling the user how to undo this change
MsgBox "Custom menu set. Run the RestoreBuiltInUI macro to clear the custom menu.", _
vbInformation, DVS_TITLE
' Exit the procedure bypassing the error handler
Exit Sub
errHandler:
' Display a message to let the user know that we detected that
' Visio was not running
MsgBox "Visio must be running!", vbOKOnly, DVS_TITLE
End Sub
Sub DeleteToolbarButton()
'Developing Visio Solutions, Chapter 16, "Customizing Visio's User Interface"
'This example demonstrates:
' retrieving an instance of Visio
' retrieving a copy of Visio's built-in toolbars
' retrieving a specific toolbarset
' deleting a toolbar button (the spelling button)
' setting the custom toolbar for use by Visio
Dim appVisio As Visio.Application ' Visio instance
Dim uiObj As Visio.UIObject
Dim toolbarSetObj As Visio.ToolbarSet
Dim toolbarItemsObj As Visio.ToolbarItems
Dim toolbarItemObj As Visio.ToolbarItem
Dim i As Integer ' Loop variable
' Set an error handler
On Error GoTo errHandler
' Retrieve the current instance of Visio
Set appVisio = GetObject(, "visio.application")
' Get the UI object for the copy of the MSOffice toolbars
Set uiObj = appVisio.BuiltInToolbars(visToolBarMSOffice)
' Get the Drawing Window toolbarsets
' NOTE: You must use ItemAtID to get the toolbarset
' using uiObj.ToolbarSets(visUIObjSetDrawing) will not work
Set toolbarSetObj = uiObj.ToolbarSets.ItemAtID(visUIObjSetDrawing)
' Get the ToolbarItems collection
Set toolbarItemsObj = toolbarSetObj.Toolbars(0).ToolbarItems
' retrieve the spelling toolbaritem
' Since we retrieved the builtin toolbars we know that we will find it.
' If we had started from a custom toolbar we would need to handle the case
' of not finding the button.
For i = 0 To toolbarItemsObj.Count - 1
' retrieve the current toolbaritem from the collection
Set toolbarItemObj = toolbarItemsObj(i)
' check whether the current item is the spelling button
If toolbarItemObj.CmdNum = Visio.visCmdToolsSpelling Then
Exit For
End If
Next i
' delete the spell check button
toolbarItemObj.Delete
' Tell Visio to actually use the new custom UI
appVisio.ActiveDocument.SetCustomToolbars uiObj
' Display a message box telling the user how to undo this change
MsgBox "Custom toolbar set. Run the RestoreBuiltInUI macro to clear the custom toolbar.", _
vbInformation, DVS_TITLE
' Exit the procedure bypassing the error handler
Exit Sub
errHandler:
' Display a message to let the user know that we detected that
' Visio was not running
MsgBox "Visio must be running!", vbOKOnly, DVS_TITLE
End Sub
Sub DropManyShapes()
Attribute DropManyShapes.VB_Description = "Demonstrates using the DropMany method to add multiple shapes to a drawing with one call."
' Developing Visio Solutions, Chapter 12, "Creating Visio drawings from a program"
' This example demonstrates:
' retrieving an instance of Visio
' retrieving the local masters collection for appVisio.ActiveDocument
' retrieving the masters collection for a document
' droping multiple masters in one call with DropMany
Dim appVisio As Visio.Application ' Visio instance
Dim pagObj As Visio.Page ' Page to work in
Dim pagsObj As Visio.Pages ' Pages collection of document
Dim mastersObj As Visio.Masters ' Master collection of stencil
Dim nCnt As Integer ' Number of masters on stencil
Dim nDropped As Integer ' Number of shapes dropped
Dim i As Integer ' Loop variable
Dim iRunMode As Integer ' DropMany mode to Demo
Const BYOBJECT = 0 ' pass master interface
Const BYINDEX = 1 ' pass index into masters collection
Const BYNAME = 2 ' pass master name
Const BYUNIQUEID = 3 ' pass unique id
' Set an error handler
On Error GoTo errHandler
' Initialize the desired demo run mode
iRunMode = BYUNIQUEID
' Retrieve the current instance of Visio
Set appVisio = GetObject(, "visio.application")
' Get the pages collection for the document
' Note the use of appVisio.ActiveDocument to refer to the current document
Set pagsObj = appVisio.ActiveDocument.Pages
' Get a reference to the first page of the collection
' The code below uses the more typical short form of the code
' Set pagObj = pagsObj.Item(1)
Set pagObj = pagsObj(1)
' Retrieve the masters collection for the local master stencil
Set mastersObj = appVisio.ActiveDocument.Masters
' Get the size of the masters collection
nCnt = mastersObj.Count
' Tell the user how to use this example if no shapes are currently in
' the local master stencil
If nCnt = 0 Then
MsgBox "This example requires shapes on the local master stencil." & _
vbCrLf & vbCrLf & _
"Drop shapes from a stencil onto the drawing page to add them" & _
vbCrLf & "to the local master stencil.", _
vbOKOnly, DVS_TITLE
Exit Sub
End If
' Setup the arrays required by DropMany
' DropMany takes 3 parameters
' An array of variants for the master(s)
' An array of doubles for the x,y drop coordinates
' An integer array DropMany fills with the shape ids for the dropped shapes
'
' The masters array can be an array of master objects, master names,
' master indices, or unique ids.
'
' If less master elements are given than coordinates, the last specified
' master is dropped for the remaining coordinates. If you want to drop n
' copies of one master and m of another you need a masters array of n+1
' elements. The first element should be a reference to the first master,
' the next n-1 elements should be left unitialized variants (VT_EMPTY),
' the last element should be a reference to the second master
' Masters array Coordinates
' |------------| |-------|
' | Master ref | | x, y |
' | VT_EMPTY | | x, y |
' | . | | x, y |
' | . | | x, y |
' | . | | x, y |
' | VT_EMPTY | | x, y |
' | Master ref | | x, y |
' |------------| |-------|
' Note if you use a Dim statement like Dim marray(6) remember that depending
' on the Option Base setting this is either 7 elements (by default) or
' 6 (if you explicitly set option base 1)
ReDim marray(1 To nCnt) As Variant
ReDim idArray(1 To nCnt) As Integer
ReDim xypts(1 To nCnt * 2) As Double
For i = 1 To nCnt
Select Case iRunMode
Case BYOBJECT
' tell to drop referenced masters by master object.
' Display a message to let the user know that we detected that
' Visio was not running
MsgBox "Visio must be running and the stencil ""VB Solutions.vss"" must be open!", vbOKOnly, DVS_TITLE
End Sub
Sub GetAllDocNames()
Attribute GetAllDocNames.VB_Description = "Demonstrates retrieving and iterating through the Visio documents collection and accessing the name property."
Dim appVisio As Visio.Application ' Visio instance
Dim docObj As Visio.Document ' A Document
Dim strDocName As String ' String to hold name
' Set an error handler
On Error GoTo errHandler
' Retrieve the current instance of Visio
Set appVisio = GetObject(, "visio.application")
' Get the first document from the Documents collection
' The code below uses the more typical short form of the code
' Set docObj = Documents.Item(1)
Set docObj = appVisio.Documents(1)
' Get the Document Name property
strDocName = docObj.Name
' Set the Text property of the text box to the document name
UserForm1.TextBox1 = strDocName
UserForm1.TextBox1.Enabled = False
' Set the label text and show the form
UserForm1.Label1.Caption = "Document name:"
UserForm1.Show
' Exit the procedure bypassing the error handler
Exit Sub
errHandler:
' Display a message to let the user know that we detected that
' Visio was not running
MsgBox "Visio must be running!", vbOKOnly, DVS_TITLE
End Sub
Sub GetFormulaResults()
Attribute GetFormulaResults.VB_Description = "Demonstrates using the GetResults method to retrieve the results of multiple shape cell formulas in one call."
' Developing Visio Solutions, Chapter 13, "Getting Information from Visio Drawings"
' This example demonstrates:
' retrieving an instance of Visio
' retrieving the current selection collection
' retrieving the ID for a shape
' using GetResults to retrieve the results of a formula for selected shapes
Dim appVisio As Visio.Application ' Visio instance
Dim selObj As Visio.Selection ' Selection window
Dim i As Integer ' Loop variable
Dim nCnt As Integer ' Count of objects in selection collection
' Set an error handler
On Error GoTo errHandler
' Retrieve the current instance of Visio
Set appVisio = GetObject(, "visio.application")
' Get the selection collection for the active window
Set selObj = appVisio.ActiveWindow.Selection
' retrieve the size of the collection
nCnt = selObj.Count
' Raise an error condition. The error number for our purposes is unimportant!
If nCnt = 0 Then Error.Raise vbObjectError + 1000
' Dimension an array to hold the returned results
ReDim rgResults(1 To nCnt) As Variant
' Dimension an array to hold the inputs to GetResults
' Each entry requires 4 elements: shape ID, section, row, and cell
' Note if we invoked GetResults on a shape instead of on the page,
' each entry would only require 3 elements: section, row, and cell
ReDim rgSRCStream(1 To nCnt * 4) As Integer
' Dimension an array to hold the unit specification for the desired
' results. If we had wanted all units the same this could have been
' a single element array initialized to the desired unit
ReDim rgUnits(1 To nCnt) As Variant
' Initialize the units array. Let's get inches for odd numbered entries
' and mm for even
For i = 1 To nCnt
If i Mod 2 = 0 Then
rgUnits(i) = "mm."
Else
rgUnits(i) = "in."
End If
Next i
' Initialize the inputs for each shape in the selection
' such that we retrieve the width of all the shapes
For i = 0 To nCnt - 1
' Shape ID - this identifies the shape we're interested in
' Display a message to let the user know that we detected that
' Visio was not running
MsgBox "Visio must be running and there must be shapes in the drawing!", vbOKOnly, DVS_TITLE
End Sub
Sub IteratePages()
Attribute IteratePages.VB_Description = "Demonstrates retrieving the pages for a document and determining whether a page is a foreground or background page."
' Developing Visio Solutions, Chapter 13, "Getting Information from Visio Drawings"
' This example demonstrates:
' retrieving an instance of Visio
' retrieving the pages collection for a document
' getting a page from the collection
' checking whether a page is a background page
Dim appVisio As Visio.Application ' Visio instance
Dim pagsObj As Visio.Pages ' Pages collection
Dim pagObj As Visio.Page ' current page in collection
Dim i As Integer ' current index into collection
' Set an error handler
On Error GoTo errHandler
' Retrieve the current instance of Visio
Set appVisio = GetObject(, "visio.application")
' retrieve the pages collection
Set pagsObj = appVisio.ActiveDocument.Pages
' Make sure the listbox is cleared
UserForm2.ListBox1.Clear
' iterate through the collection
For i = 1 To pagsObj.Count
' retrieve the page object at the current index
' The code below uses the more typical short form of the code
' Set pagObj = pagsObj.Item(i)
Set pagObj = pagsObj(i)
' Check whether the current page is a background page
' Display the name of all the foreground pages
If pagObj.Background = False Then
UserForm2.ListBox1.AddItem pagObj.Name
End If
Next i
' Display the listbox
UserForm2.Show
' Exit the procedure bypassing the error handler
Exit Sub
errHandler:
' Display a message to let the user know that we detected that
' Visio was not running
MsgBox "Visio must be running and there must be at least one page in the drawing!", vbOKOnly, DVS_TITLE
End Sub
Sub ListLayers()
Attribute ListLayers.VB_Description = "Demonstrates retrieving the layers collection for a page and accessing the names of the layers."
' Developing Visio Shapes, Chapter 14, "Working with Drawings and Shapes"
' This example demonstrates:
' retrieving an instance of Visio
' retrieving the layers collection for a page
' retrieving a layer from the layers collection
' retrieving the name of a layer
Dim appVisio As Visio.Application ' Visio instance
Dim layersObj As Visio.Layers ' layers collection
Dim layerObj As Visio.Layer ' current layer from collection
Dim layerName As String ' variable to hold name of layer
Dim i As Integer ' current index into the collection
' Set an error handler
On Error GoTo errHandler
' Retrieve the current instance of Visio
Set appVisio = GetObject(, "visio.application")
' retrieve the layers collection for the active page
Set layersObj = appVisio.ActivePage.Layers
' Make sure that the listbox is cleared
UserForm2.ListBox1.Clear
' iterate through the layers collection
For i = 1 To layersObj.Count
' retrieve the layer object at the current index
' The code below uses the more typical short form of the code
' Set layerObj = layersObj.Item(i)
Set layerObj = layersObj(i)
' retrieve the name of the current layer
layerName = layerObj.Name
' add the name to the listbox
UserForm2.ListBox1.AddItem layerName
Next i
' Display the listbox
UserForm2.Show
' Exit the procedure bypassing the error handler
Exit Sub
errHandler:
' Display a message to let the user know that we detected that
' Visio was not running
MsgBox "Visio must be running and a drawing active!", vbOKOnly, DVS_TITLE
End Sub
Sub ListStyles()
Attribute ListStyles.VB_Description = "Demonstrates retrieving the styles collection and the names of the styles."
' Developing Visio Solutions, Chapter 14, "Working with Drawings and Shapes."
' This example demonstrates:
' retrieving an instance of Visio
' retrieving the styles collection
' retrieving the name of a style from the style object
Dim appVisio As Visio.Application ' Visio instance
Dim stylsObj As Visio.Styles ' Styles collection
Dim stylObj As Visio.Style ' current style from collection
Dim curStyleIndx As Integer ' index into style collection
Dim styleName As String ' name of current style
' Set an error handler
On Error GoTo errHandler
' Retrieve the current instance of Visio
Set appVisio = GetObject(, "visio.application")
' Retrieve the Styles collection of the current document
' Note the use of appVisio.ActiveDocument to get the current document
Set stylsObj = appVisio.ActiveDocument.Styles
' Make sure the listbox is cleared
UserForm2.ListBox1.Clear
' Iterate through the styles
For curStyleIndx = 1 To stylsObj.Count
' get the object for the current style
Set stylObj = stylsObj(curStyleIndx)
' Get the name property from the style object
styleName = stylObj.Name
' Add the style name to the listbox
UserForm2.ListBox1.AddItem styleName
Next curStyleIndx
' Display the list
UserForm2.Show
' Exit the procedure bypassing the error handler
Exit Sub
errHandler:
' Display a message to let the user know that we detected that
' Visio was not running
MsgBox "Visio must be running and a drawing active!", vbOKOnly, DVS_TITLE
End Sub
Sub LoadInterfaceFile()
Attribute LoadInterfaceFile.VB_Description = "Demonstrates loading a custom UI from a file."
'Developing Visio Solutions, Chapter 16, "Customizing Visio's User Interface"
' This example demonstrates:
' retrieving an instance of Visio
' loading a custom UI from a file
Dim appVisio As Visio.Application ' Visio instance
Dim uiObj As Visio.UIObject
' Retrieve the current instance of Visio
Set appVisio = GetObject(, "visio.application")
' retrieve the UI object for the copy of the builtin menus
Set uiObj = appVisio.BuiltInToolbars(Visio.visToolBarMSOffice)
' tell Visio to use the custom UI contained in the specified file
uiObj.LoadFromFile "shortcut.vsu"
appVisio.ActiveDocument.SetCustomToolbars uiObj
' Display a message box telling the user how to undo this change
MsgBox "Custom menu set. Run the RestoreBuiltInUI macro to clear the custom toolbar.", _
vbInformation, DVS_TITLE
End Sub
Sub NoVisioUI()
Attribute NoVisioUI.VB_Description = "Demonstrates hiding the Visio UI (menus, toolbars, and statusbars)."
'Developing Visio Solutions, Chapter 16, "Customizing Visio's User Interface"
' This example demonstrates:
' retrieving an instance of Visio
' retrieving the current state for Visio's statusbar, toolbar, and menus
' turning of display of Visio's statusbar, toolbar, and menus
Dim appVisio As Visio.Application ' Visio instance
' Display a message to let the user know that we detected that
' Visio was not running
MsgBox "Visio must be running and a drawing active!", vbOKOnly, DVS_TITLE
End Sub
Function ShapesCount(root As Visio.Shape) As Integer
Attribute ShapesCount.VB_Description = "Demonstrates retrieving the shapes collection, retrieving a shape from the collection, and determining the type of a shape."
' Developing Visio Solutions, Chapter 13, "Getting Information About Visio Drawings"
' This example demonstrates:
' retrieving the shapes collection from a page or shape object
' retrieving a shape from the collection
' determining a shape's type
' This example assumes that the Pages collection contains one or more groups.
' The function counts shapes in groups, but does not count the groups that contain
' the shapes (i.e. a group of 2 shapes returns 2 not 3 as it would if the group shape
' were counted)
Dim shpsObj As Visio.Shapes ' shapes collection
Dim shpObj As Visio.Shape ' shape object
Dim i As Integer ' loop variable
Dim iCount As Integer ' return value
' Initialize the count to zero
iCount = 0
' Retrieve the shapes collection from the root shape
Set shpsObj = root.Shapes
' Loop through the shapes in the collection
For i = 1 To shpsObj.Count
' Retrieve the current shape
' The code below uses the more typical short form of the code
' Set shpObj = shpsObj.Item(i)
Set shpObj = shpsObj(i)
' Check if the current shape is a group. If it is, we must call
' this routine again (recursive call) to process the shapes within
' the group
If shpObj.Type = visTypeGroup Then
' Set the count to the current count + the count returned
' from the processing of the group
iCount = iCount + ShapesCount(shpObj)
Else
' Increment the shape count
iCount = iCount + 1
End If
Next
' Return the count of shapes starting at root
ShapesCount = iCount
End Function
Sub ShowPageConnections()
Attribute ShowPageConnections.VB_Description = "Demonstrates retrieving the page connects collection and processing the FromSheet and ToSheet properties."
' Developing Visio Solutions, Chapter 13, "Getting Information from Visio Drawings"
' This example demonstrates:
' retrieving an instance of Visio
' retrieving the connects collection for the page
' iterating through the collection
' accessing the fromsheet and tosheet properties
'
' This example assumes that the drawing contains glued shapes.
Dim appVisio As Visio.Application ' Visio instance
Dim pagsObj As Visio.Pages ' page collection of document
Dim pagObj As Visio.Page ' page to work on
Dim fromObj As Visio.Shape ' object from connection connects to
Dim toObj As Visio.Shape ' object to connection connects to
Dim consObj As Visio.Connects ' Connects collection
Dim conObj As Visio.Connect ' Connect object from collection
Dim curConnIndx As Integer ' Loop variable for iterating through connections
Dim fromData As Integer ' type of from connection
Dim fromStr As String ' string to hold description of from connection
Dim toData As Integer ' type of to connection
Dim toStr As String ' string to hold description of to connection
' Set an error handler
On Error GoTo errHandler
' Retrieve the current instance of Visio
Set appVisio = GetObject(, "visio.application")
' Get the pages collection for the document
' Note the use of appVisio.ActiveDocument to refer to the current document
Set pagsObj = appVisio.ActiveDocument.Pages
' Get a reference to the first page of the collection
' The code below uses the more typical short form of the code
' Set pagObj = pagsObj.Item(1)
Set pagObj = pagsObj(1)
' Get the connects collection for the page
Set consObj = pagObj.Connects
' Make sure the list box is emptied
UserForm2.ListBox1.Clear
' Loop through the connects collection
For curConnIndx = 1 To consObj.Count
' Get the current connect object from the collection
